perm filename MISCUR.SAI[SYS,HE]1 blob
sn#004199 filedate 1972-06-05 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
RECORD PAGE DESCRIPTION
00001 00001 VALID 00009 PAGES
00005 00002 BEGIN "MISC"
00008 00003 ⊃ ROUTINE TO CLEAN UP LINES FOR FUTURE PROCESSING
00011 00004 ⊃ NOW ATTEMPT TO EXTEND DANGLING ENDPOINTS [¬JOIN] TO SOME CORNER
00017 00005 ⊃ FIND ALL LINES WHICH MAY BE PART OF A CLOSED OUTLINE
00019 00006 ⊃ FIND LOWEST POINT IN CLOSED OUTLINE, IF THERE IS A CLOSED LINE
00022 00007 ⊃ PROCESS FITTED OUTLINE
00026 00008 ⊃ COMPUTE 'ANGLE' FOR CLOSED CURVE ROUTINE
00028 00009 ⊃ MAIN PROGRAM
00030 ENDMK
⊗;
BEGIN "MISC"
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE "SQRT[SYS,HE]" LOAD_MODULE;
REQUIRE 500 STRING_SPACE;
REQUIRE -1 NEW_ITEMS;
EXTERNAL INTEGER PROCEDURE CUR1(REAL ARRAY D,ODAT;REFERENCE INTEGER SCNT,SMAX);
EXTERNAL PROCEDURE CUROFF;
EXTERNAL REAL PROCEDURE SQRT(REAL X);
EXTERNAL PROCEDURE CURVON;
EXTERNAL PROCEDURE ARROW_DPY(REAL X,Y);
EXTERNAL PROCEDURE FADCHG(REAL X,Y;PROCEDURE PROC);
EXTERNAL PROCEDURE FRDCHG(REAL X,Y;PROCEDURE PROC);
INTEGER J,I,EOF,BRK, DISSIZ;
INTERNAL INTEGER FRAMEY;
STRING INP;
INTEGER ITEMVAR NEWBLOB;
EXTERNAL BOOLEAN DD_DISP, XDEB, DISCUR;
EXTERNAL INTEGER FRAMEX;
SAFE INTEGER ARRAY DISPL[1:300];
DEFINE CRLF="'15&'12",SAFEX="SAFE", SMAX="100", ⊃="COMMENT",COORDIF="15.0",
COORDMAX="4.0",PARA=".4",
DPYSETUP="IF DD_DISP THEN RELPOG(FRAMEX);
IF FRAMEX<0 THEN FRAMEX ← GETPOG;
DPYSET(DISPL);
DPYBRT(7)";
BOOLEAN STAT_CURV;
FORWARD SIMPLE REAL PROCEDURE ANG(REAL DX,DY);
⊃ DISPLAY LINE BEING FIT;
INTERNAL PROCEDURE DISP(SAFEX REAL ARRAY D);
BEGIN INTEGER X, Y, CNT, PNT, I, J;
SAFEX INTEGER ARRAY DISPL[1:DISSIZ];
IF FRAMEY<0 THEN FRAMEY ← GETPOG;
DPYSET(DISPL);
DPYBRT(1);
FADCHG(0,0,AIVECT);
J ← 1;
DO BEGIN
CNT ← ABS(D[J,1]);
PNT ← D[J,2];
FOR I ← 1 STEP 1 UNTIL CNT DO FRDCHG(D[J+I,1],D[J+I,2],RPOINT);
J ← PNT;
END UNTIL ¬J;
DPYOUT(FRAMEY);
END;
⊃ ROUTINE TO CLEAN UP LINES FOR FUTURE PROCESSING;
PROCEDURE FIXUP(REAL ARRAY D; REFERENCE INTEGER S;INTEGER CNT);
BEGIN SAFEX REAL ARRAY LINE[1:CNT,1:4];
SAFEX INTEGER ARRAY JOIN[1:CNT,1:2];
INTEGER DCNT, I, IND, C, J, K, A, B, F, G, E;
REAL TEST, DD, X, Y, X1, Y1, X2, Y2, X3, Y3, XX, YY, A1, B1, C1, A2,
B2, C2, GX, GY, E1, E2, X4, Y4, TST;
LABEL L1, L2, L3, L4, L5, L6, L7, L8;
DEFINE HANG(I)="JOIN[I,1]", OUTER(I)="JOIN[I,2]";
⊃ FILL LINE ARRAY AND SET JOIN ARRAY IF TWO LINES HAVE COMMON CORNER;
IF DISCUR THEN BEGIN OUTSTR("DEBUG FIXUP?");XDEB←INCHWL="Y"; END;
C ← 0; IND ←1;
DO IF (DCNT←D[IND,1])>0 THEN
BEGIN "OUT"
FOR I←1 STEP 1 UNTIL DCNT-1 DO
BEGIN
J ← C+I;
K ← IND+I;
FOR A←1,2 DO BEGIN LINE[J,A]←D[K,A];LINE[J,A+2]←D[K+1,A];END;
JOIN[J,1] ← JOIN[J,2] ← 1;
END;
C ← C+DCNT;
K ← IND+DCNT;
FOR A←1,2 DO BEGIN LINE[C,A]←D[K,A];LINE[C,A+2]←D[IND+1,A];END;
JOIN[C,1] ← JOIN[C,2] ← 1;
DONE;
END "OUT" UNTIL (IND←IND+ABS(DCNT)+1)≥S;
IND ←1;
DO BEGIN
DCNT ← ABS(D[IND,1]);
IF D[IND,1]<0 THEN
BEGIN "IN"
FOR I←1 STEP 1 UNTIL DCNT-1 DO
BEGIN
K ← C+I;
J ← IND+I;
FOR A←1,2 DO BEGIN LINE[K,A]←D[J,A];LINE[K,A+2]←D[J+1,A];END;
IF I>1∧LINE[K-1,3]=LINE[K,1]∧LINE[K-1,4]=LINE[K,2] THEN
JOIN[K-1,2] ← JOIN[K,1]←1 ELSE JOIN[K,1] ← 0;
JOIN[K,2] ← 0;
END;
C ← C+DCNT-1;
END "IN";
IND ←IND+DCNT+1;
END UNTIL IND≥S;
⊃ NOW ATTEMPT TO EXTEND DANGLING ENDPOINTS [¬JOIN] TO SOME CORNER;
⊃ 1. FIND A DANGLING ENDPOINT;
SETFORMAT(10,3);
FOR I← 1 STEP 1 UNTIL C DO
BEGIN "DANGLE" REAL FOO;
IF ¬JOIN[I,1] THEN E←1 ELSE
L2: IF ¬JOIN[I,2] THEN E←3 ELSE GO TO L1;
X ← LINE[I,E];
Y ← LINE[I,E+1];
K ← IF E=1 THEN 3 ELSE 1;
X4 ← LINE[I,K];
Y4 ← LINE[I,K+1];
FOO ← SQRT((X-X4)↑2+(Y-Y4)↑2);
⊃ 2. NOW I IS A DANGLING LINE AND E POINTS TO THE END POINT.
X,Y ARE COORDINATES OF THE DANGLING END
X4,Y4 ARE COORDINATES OF THE OTHER END.
FOR ALL ENDPOINTS WITHIN COORDIF*2 OF IT, INTERSECT THE
LINES AND FIND THE DISTANCE FROM EACH ENDPOINT TO THE
INTERSECTION. SAVE THE BEST ONE. ;
TST ← TEST ← COORDIF+1.0;
FOR J←1 STEP 1 UNTIL C DO IF I≠J THEN FOR K←1,3 DO
BEGIN "MATCH" LABEL L4,L1;
XX ← LINE[J,K];
YY ← LINE[J,K+1];
IF XX=X4∧YY=Y4 THEN GO TO L1;
DD ← SQRT((XX-X)↑2+(YY-Y)↑2);
IF XDEB THEN
BEGIN INTEGER I;
DPYSETUP;
FADCHG(0,0,AIVECT);
FOR I←1 STEP 1 UNTIL C DO
BEGIN
FRDCHG(LINE[I,1],LINE[I,2],RIVECT);
FRDCHG(LINE[I,3],LINE[I,4],RVECT);
END;
ARROW_DPY(X,Y);
ARROW_DPY(XX,YY);
FADCHG(50,260,AIVECT);
DPYSST("DIST="&CVF(DD));
END;
IF ¬DD THEN
BEGIN
JOIN[I,(E DIV 2)+1] ← JOIN[J,(K DIV 2)+1] ← 1;
GO TO L3;
END;
IF DD<COORDIF*2 THEN
BEGIN "INTER"
A ← IF E=1 THEN 3 ELSE 1;
B ← IF K=1 THEN 3 ELSE 1;
X1 ← LINE[I,A];
Y1 ← LINE[I,A+1];
X2 ← LINE[J,B];
Y2 ← LINE[J,B+1];
A1 ← YY-Y2;
B1 ← X2-XX;
C1 ← X2*A1+Y2*B1;
A2 ← Y1-Y;
B2 ← X-X1;
C2 ← X*A2+Y*B2;
DD ← A1*B2-A2*B1;
IF ABS(DD)<0.01 THEN GO TO L4;
X3 ← (C1*B2-C2*B1)/DD;
Y3 ← (A1*C2-A2*C1)/DD;
E1 ← SQRT((X3-X)↑2+(Y3-Y)↑2);
E2 ← SQRT((X3-XX)↑2+(Y3-YY)↑2);
DCNT ← JOIN[J,(K DIV 2)+1];
IF E1>COORDIF∨(E2>(IF DCNT THEN COORDMAX ELSE COORDIF)) THEN GO TO L4;
IF E1<TST+2.0∧E2<TEST∧SQRT((X3-X4)↑2+(Y3-Y4)↑2)>FOO THEN
BEGIN
TST ← E1;
TEST ← E2;
F ← J;
G ← K;
GX ← X3;
GY ← Y3;
END;
END "INTER";
L4: IF XDEB THEN
BEGIN
DPYSST(" E1="&CVF(E1)&" E2="&CVF(E2));
DPYOUT(FRAMEX);
INCHWL;
END;
L1: END "MATCH";
IF TEST>COORDIF THEN GO TO L3;
⊃ 3. IF INTERSECTED JOINED LINE, MOVE DANGLING LINE TO CORNER.
IF BOTH LINES DANGLING, USE INTERSECTION AND TEST FOR PARALLEL;
DCNT ← JOIN[F,(G DIV 2)+1];
IF DCNT THEN
BEGIN "JOINED"
LINE[I,E] ← LINE[F,G];
LINE[I,E+1] ← LINE[F,G+1];
JOIN[I,(E DIV 2)+1] ← 1;
END "JOINED" ELSE BEGIN "NOJ"
A ← IF E=1 THEN 3 ELSE 1;
B ← IF K=1 THEN 3 ELSE 1;
IF ABS((LINE[I,A+1]-GY)*(GX-LINE[F,A])-(LINE[I,A]-GX)*(GY-LINE[F,B+1]))>PARA THEN
BEGIN "NOP"
LINE[I,E] ← LINE[F,G] ← GX;
LINE[I,E+1] ← LINE[F,G+1] ← GY;
JOIN[I,(E DIV 2)+1] ← JOIN[F,(G DIV 2)+1] ← 1;
END "NOP" ELSE BEGIN "PARA"
LINE[I,E] ← LINE[F,B];
LINE[I,E+1] ← LINE[F,B+1];
JOIN[I,(E DIV 2)+1] ← 1;
IF I<C THEN
BEGIN "PACK"
ARRBLT(LINE[F,1],LINE[F+1,1],(C-F)*4);
ARRBLT(JOIN[F,1],JOIN[F+1,1],(C-F)*2);
C ← C-1;
END "PACK";
END "PARA";
END "NOJ";
L3: IF E=1 THEN GO TO L2;
L1: END "DANGLE";
⊃ FIND ALL LINES WHICH MAY BE PART OF A CLOSED OUTLINE;
JOIN[1,1] ← 0;
ARRBLT(JOIN[1,2],JOIN[1,1],C*2-1);
L5: A ← FALSE;
FOR I←1 STEP 1 UNTIL C DO IF ¬HANG(I) THEN
BEGIN "SCAN"
X1 ← LINE[I,1];
Y1 ← LINE[I,2];
X2 ← LINE[I,3];
Y2 ← LINE[I,4];
F ← G ← FALSE;
FOR J← 1 STEP 1 UNTIL C DO IF ¬HANG(J)∧I≠J THEN
BEGIN "COMP"
X ← LINE[J,1];
Y ← LINE[J,2];
XX ← LINE[J,3];
YY ← LINE[J,4];
IF (X1=X∧Y1=Y)∨(X1=XX∧Y1=YY) THEN F←TRUE;
IF (X2=X∧Y2=Y)∨(X2=XX∧Y2=YY) THEN G←TRUE;
IF F∧G THEN GO TO L6;
END "COMP";
HANG(I) ← A ← TRUE;
L6: END "SCAN";
IF A THEN GO TO L5;
IF XDEB THEN
BEGIN
DPYSETUP;
FADCHG(0,0,AIVECT);
FOR I←1 STEP 1 UNTIL C DO IF ¬HANG(I) THEN
BEGIN
FRDCHG(LINE[I,1],LINE[I,2],RIVECT);
FRDCHG(LINE[I,3],LINE[I,4],RVECT);
END;
DPYBRT(7);
FOR I←1 STEP 1 UNTIL C DO IF HANG(I) THEN
BEGIN
FRDCHG(LINE[I,1],LINE[I,2],RIVECT);
FRDCHG(LINE[I,3],LINE[I,4],RVECT);
END;
DPYOUT(FRAMEX);
INCHWL;
END;
⊃ FIND LOWEST POINT IN CLOSED OUTLINE, IF THERE IS A CLOSED LINE;
S ← IND ← 1;
Y ← 0;
FOR I←1 STEP 1 UNTIL C DO IF ¬HANG(I) THEN
FOR K←2,4 DO IF LINE[I,K]>Y THEN BEGIN A←I;B←K;Y←LINE[I,K];END;
IF Y<1.0 THEN GO TO L4;
X ← LINE[A,B-1];
⊃ FIND OUTERMOST CLOSED CURVE AND PUT IN D BY STARTING WITH LOWEST ENDPOINT
AND FINDING SUCCESSIVE EDGES WITH SMALLEST ANGLES BETWEEN THEM;
X1 ← XX ← X;
YY ← Y+100.0;
Y1 ← Y;
B ← 0;
L7: A1 ← 100.0;
B1 ← ANG(XX-X,YY-Y);
FOR I←1 STEP 1 UNTIL C DO IF ¬HANG(I)∧I≠B THEN FOR J←1,3 DO IF LINE[I,J]=X∧LINE[I,J+1]=Y THEN
BEGIN "GET"
F ← IF J=1 THEN 3 ELSE 1;
C1 ← ANG(LINE[I,F]-X,LINE[I,F+1]-Y);
C1 ← IF C1<B1 THEN 4+C1-B1 ELSE C1-B1;
IF C1<A1 THEN BEGIN A1←C1; A←I; E←F; END;
END "GET";
IF A1=100.0 THEN BEGIN OUTSTR("CLOSED CURVE FINDER BLEW UP"&CRLF);
CALL(0,"EXIT"); END;
OUTER(A) ← TRUE;
XX ← D[S←S+1,1] ← X;
YY ← D[S,2] ← Y;
X ← LINE[A,E];
Y ← LINE[A,E+1];
B ← A;
IF X≠X1∨Y≠Y1 THEN GO TO L7;
D[IND,1] ← S-IND;
D[IND,2] ← 0;
IND ← S+1;
L4: FOR I←1 STEP 1 UNTIL C DO IF ¬OUTER(I) THEN
BEGIN
D[IND+1,1] ← LINE[I,1];
D[IND+1,2] ← LINE[I,2];
X ← D[IND+2,1] ← LINE[I,3];
Y ← D[IND+2,2] ← LINE[I,4];
OUTER(I) ← TRUE;
A ← 2;
L8: FOR K←1 STEP 1 UNTIL C DO IF ¬OUTER(K)∧X=LINE[K,1]∧Y=LINE[K,2] THEN
BEGIN
A ← A+1;
X ← D[IND+A,1] ← LINE[K,3];
Y ← D[IND+A,2] ← LINE[K,4];
OUTER(K) ← TRUE;
GO TO L8;
END;
D[IND,1] ← -A;
D[IND,2] ← 0;
IND ← IND+A+1;
END;
S ← IND;
D[S,1] ← D[S,2] ← 0;
END;
⊃ PROCESS FITTED OUTLINE;
PROCEDURE PROCESS(SAFEX REAL ARRAY D; INTEGER SCNT,TST);
BEGIN
INTEGER OUTS, INS, OS, IS, IND, CIN, COUT;
SIMPLE PROCEDURE COUNT(SAFEX REAL ARRAY D; REFERENCE INTEGER S, O, I, OS, IS);
BEGIN INTEGER C;
O← I ← OS ← IS ← 0;
IND ← 1;
DO BEGIN
C ← ABS(D[IND,1]);
IF D[IND,1]>0 THEN BEGIN OS←OS+1;O←O+C; END ELSE
BEGIN IS←IS+1; I←I+C; END;
IND ← IND+C+1;
END UNTIL IND≥S;
END;
COUNT(D,SCNT,OUTS,INS,OS,IS);
IF IS>0∧¬TST THEN
BEGIN
FIXUP(D,SCNT,OUTS+INS);
COUNT(D,SCNT,OUTS,INS,OS,IS);
END;
IF OS>1 THEN OUTSTR(CVS(OS)&" CLOSED CURVES FOUND"&CRLF);
CIN ← COUT ← 0;
IND ← 1;
IF (XDEB←¬RUN∨DIS_CUR) THEN
BEGIN
DPYSETUP;
FADCHG(0,0,AIVECT);
END;
BEGIN "FILL"
SAFEX REAL ARRAY AIN[1:4,0:INS-IS],AOUT[1:2,0:OUTS];
DO BEGIN "LOOP"
OS ← ABS(D[IND,1]);
IF D[IND,1]>0 THEN
BEGIN "OUTSID"
IF ¬COUT THEN
BEGIN
IF XDEB THEN
BEGIN
DPYBRT(7);
FRDCHG(D[IND+1,1],D[IND+1,2],RIVECT);
END;
FOR I←1 STEP 1 UNTIL OS DO
BEGIN
AOUT[1,COUT←COUT+1]←D[IND+I,1];
AOUT[2,COUT] ← D[IND+I,2];
IF XDEB THEN FRDCHG(AOUT[1,COUT],AOUT[2,COUT],RVECT);
END;
IF XDEB THEN FRDCHG(AOUT[1,1],AOUT[2,1],RVECT);
END;
END "OUTSID" ELSE BEGIN
IF XDEB THEN DPYBRT(1);
FOR I←1 STEP 1 UNTIL OS-1 DO
BEGIN "INSIDE"
AIN[1,CIN←CIN+1] ← D[IND+I,1];
AIN[2,CIN] ← D[IND+I,2];
AIN[3,CIN] ← D[IND+I+1,1];
AIN[4,CIN] ← D[IND+I+1,2];
IF XDEB THEN
BEGIN
FRDCHG(AIN[1,CIN],AIN[2,CIN],RIVECT);
FRDCHG(AIN[3,CIN],AIN[4,CIN],RVECT);
END;
END "INSIDE";
END;
END "LOOP" UNTIL (IND←IND+OS+1)>SCNT;
IF XDEB THEN
BEGIN
DPYOUT(FRAMEX);
INCHWL;
END;
IF CIN THEN
BEGIN "IN"
AIN[1,0] ← CIN;
GLOBAL MAKE INSIDE_EDGES⊗NEWBLOB≡GLOBAL NEW(AIN);
END "IN";
IF COUT THEN
BEGIN "OUT"
AOUT[1,0] ← COUT;
GLOBAL MAKE BOUNDARY⊗NEWBLOB≡GLOBAL NEW(AOUT);
STAT_CURV ← TRUE;
END "OUT";
PUT NEWBLOB IN BLOBS;
END "FILL";
END;
⊃ COMPUTE 'ANGLE' FOR CLOSED CURVE ROUTINE;
SIMPLE REAL PROCEDURE ANG(REAL DX, DY);
BEGIN REAL A;
A ← IF DY≥0 THEN DY↑2 ELSE -(DY↑2);
A ← A/(DX↑2+DY↑2);
IF DX<0 THEN A←2-A ELSE IF DY<0 THEN A←4+A;
RETURN(A);
END;
⊃ FIT COMMAND ENTRY
STATUS= -2 CURVE FITTER REJECTED OBJECT
0 OK - CLOSED OUTLINE
1 OK - LINE SEGMENT ;
MESSAGE PROCEDURE CURVE_FIT(REAL ARRAY D);
BEGIN SAFEX REAL ARRAY OUTDAT[1:SMAX,1:2];
INTEGER SCNT, TST;
TST ← CURVE_STATUS;
NEWBLOB ← ITVAR_II;
XDEB ← FALSE;
IF (CURVE_STATUS←CUR1(D,OUTDAT,SCNT,SMAX))<0 THEN RETURN;
STAT_CURV ← FALSE;
CURVE_STATUS ← 0;
PROCESS(OUTDAT,SCNT,TST);
IF XDEB THEN DISP(D);
IF ¬STAT_CURV THEN CURVE_STATUS ← 1;
END;
⊃ MAIN PROGRAM;
LABEL L1;
SETBREAK(1,'12,'15,"IN");
PUT_DATA(0,0,"CURVE");
OVERLAY ← TRUE;
DPYCLR;
FRAMEY ← FRAMEX ← -1;
YES_CUR ← TRUE;
I ← -1;
CODE('51300000000,I);
DD_DISP ← ¬(I LAND '400000000000);
L1: IF RUN∧¬DEB_CUR THEN WHILE TRUE DO
BEGIN
I ← GET_ENTRY('170,"EDGE","CURVE","CURVE_FIT");
QUEUE('600,I);
IF DEB_CUR THEN GO TO L1;
END;
WHILE TRUE DO
BEGIN
IF RUN∧¬DEB_CUR THEN GO TO L1;
OUTSTR("DEBUG? ");
IF INCHWL="Y" THEN CURVON ELSE CUROFF;
SETFORMAT(0,0);
OPEN(1,"DSK",0,2,2,1000,BRK,EOF);
OUTSTR("SET # =");
I ← CVD(INCHWL);
LOOKUP(1,"DATA"&CVS(I),J);
IF J THEN USERERR(0,0,"LOOKUP FAILED");
I ← INTSCAN(INP←INPUT(1,1),BRK);
BEGIN SAFEX REAL ARRAY DAT[1:I,1:2];
FOR J←1 STEP 1 UNTIL I DO
BEGIN
INP ← INPUT(1,1);
DAT[J,1]←REALSCAN(INP,BRK);
DAT[J,2]←REALSCAN(INP,BRK);
END;
DISSIZ ← I+20;
DISP(DAT);
CURVE_STATUS←0;
CURVE_FIT(DAT);
END;
RELEASE(1);
RELEASE(3);
END;
END;